C Размещено на http://tms.ystu.ru

character *20 name

Call Grinit

Call MMS

Call SetMod(1,3)

Call SetBgr(-1)

c организация диалога для ввода параметров

c создание запроса

write (*,1)

c формат запроса

1 format (/////1x,'Пожалуйста введите координаты точки:',/1x,'x='\)

read (*,2)x

2 format (f4.0)

write (*,3)

3 format (/1x,'',/1x,'y='\)

read (*,4)y

4 format (f4.0)

c запись информации в файл

write (*,5)

5 format (//1x,'Пожалуйста введите имя файла для записи:'\)

read (*,'(A20)') name

open (1,file=name,status='unknown')

write (1,6)x,y

6 format(1x,'x=',f4.0,5x,'y=',f4.0)

close(1)

c открытие страницы

Call Page(250.,250.,'Postnov_1',9,1)

c имя пользователя

c цвет надписи

Call SetPen (1)

c наклон шрифта

Call italic (1)

Call symbol (120.,230.,10.,'Postnov_D.V._MT-55',18,0.)

c оси системы координат

c цвет осей системы координат

Call SetPen(2)

Call Narrow (x,y,x+80.,y,5.,2)

Call symbol (x+76.,y+2.,7.,'X',1,0.)

Call Narrow (x,y,x,y+80.,5.,2)

Call symbol (x-6.,y+75.,7.,'Y',1,0.)

c осевые линии криволинейного контура

c цвет осевых линий

Call SetPen(7)

c горизонтальная осевая линия

Call MovE (x-5.,y+30.,0)

Call MovB (10.,0.,1)

Call MovB (2.,0.,0)

Call MovB (1.,0.,1)

Call MovB (2.,0.,0)

Call MovB (10.,0.,1)

Call MovB (2.,0.,0)

Call MovB (1.,0.,1)

Call MovB (2.,0.,0)

Call MovB (10.,0.,1)

Call MovB (2.,0.,0)

Call MovB (1.,0.,1)

Call MovB (2.,0.,0)

Call MovB (10.,0.,1)

Call MovB (2.,0.,0)

Call MovB (1.,0.,1)

Call MovB (2.,0.,0)

Call MovB (20.,0.,1)

c вертикальная осевая линия

Call MovE (x+50.,y+5.,0)

Call MovB (0.,10.,1)

Call MovB (0.,2.,0)

Call MovB (0.,1.,1)

Call MovB (0.,2.,0)

Call MovB (0.,10.,1)

Call MovB (0.,2.,0)

Call MovB (0.,1.,1)

Call MovB (0.,2.,0)

Call MovB (0.,10.,1)

Call MovB (0.,2.,0)

Call MovB (0.,1.,1)

Call MovB (0.,2.,0)

Call MovB (0.,15.,1)

c вычерчивание криволинейного контура

c цвет линий нонтура

Call SetPen(6)

R=20.

Call MovE (x,y+30.,0)

Call MovB (50.,30.,1)

Call MovB (20.,-30.,1)

Call MovB (-70.,0.,0)

Call MovB (50.,-20.,1)

Call arcib (20.,x+50.+R,y+30.,0)

Call Reset

Call beglev

c нанесение размеров

c цвет линий размеров

Call SetPen(4)

c нижний размер 30 мм.

r=10.

s=30.

Call Rotate(0.,0.,-90.)

Call Transl(x,y+30.)

Call str(r,s)

Call symbol(s/2+4.,-r,5,'30',2,180.)

Call Reset

c верхний размер 30 мм.

r=10.

s=30.

Call Rotate(0.,0.,90.)

Call Transl(x+70.,y+30.)

Call str(r,s)

Call symbol(s/2-4.,-r,5,'30',2,0.)

Call Reset

Call MovE(x+50.,y+60.,0)

Call MovB(20.,0.,1.)

c радиус 20 мм.

R=20.

Call Rotate(0.,0.,-45.)

Call Transl(x+50.,y+30.)

Call rad(R)

Call symbol(R/2-5.,0.,5,'R20',3,0.)

Call Reset

c размер 50 мм.

r=10.

s=50.

Call Transl(x,y)

Call str(r,s)

Call symbol(s/2-4.,-r,5,'50',2,0.)

Call Reset

Call MovE(x+50.,y,0)

Call MovB(0.,10.,1.)

Call endlev

Call EndPg('Postnov_1')

End

c подпрограмма линейных размеров

Subroutine str(r,s)

x=0.

y=0.

y1=y-r

y2=y1-r/3

Call MovE(x,y,0)

Call MovE(x,y2,1)

Call MovE(x,y1,0)

Call MovA(4.,10.,1)

Call MovE(x,y1,0)

Call MovA(4.,350.,1)

Call MovE(x,y1,0)

Call MovE(x+s,y1,1)

Call MovA(4.,170.,1)

Call MovE(x+s,y1,0)

Call MovA(4.,190.,1)

Call MovE(x+s,y2,0)

Call MovE(x+s,y,1)

Return

End

c подпрограмма радиуса

Subroutine rad(R)

Call MovE(x,y,0)

Call MovE(R,y,1)

Call MovA(4.,170.,1)

Call MovE(R,y,0)

Call MovA(4,190.,1)

Return

End